open Str;;

(* Consts *)
let epsilon = 0.001 ;; (* values less than this considered zero *)
let max_period = 1000.0 ;; (* Largest allowable period *)
let max_time = 1000.0 ;; (* Max simlution time *)
let line_break = "\n-------------\n";;

(* Global list of toggle times -- needs for printing output *)
let allToggleTimes : (int * float list) list ref = ref [];;

(* Global list of all job IDs *)
let allJIDs = ref [];;

(* General Functions *)
let max a b =
  if a > b then a else b ;;

let min a b =
  if a > b then b else a ;;
  
let sign (f : float) : int =
    if (f < 0.) then -1
    else (if (f > 0.) then 1 
    else 0) ;;
  
(* Print out to a file all of the numbers in the toggle times list *) 
let rec printToggle out list jid =
	match list with
        | [] -> ()
        | a::[] -> Printf.fprintf out "%f %d\n\n" a jid
        | a::b::c -> Printf.fprintf out "%f %d\n%f %d\n\n" a jid b jid;
            				 printToggle out c jid         
;;
  
let rec printJobSchedule (out : out_channel) (jobIDs : int list) =
		match jobIDs with
      | [] -> ()
      | jid::tl -> printToggle out (List.assoc jid !allToggleTimes) jid; printJobSchedule out tl
;;    

(* Drop the first n elements of the list and return the rest. *)
let rec drop n l =
    match n, l with
         | 0, _ -> l
         | _, [] -> []
         | _, (_ :: tl) -> drop (n - 1) tl
;;

(* Data types *)
type event =
  Completion |
  Release |
  ZeroLax ;;
  
type jobState =
  Running |
  Paused |
  Completed ;;

type eventObject = {
  eventType : event;
  eventLength : float;
  creatingJob : int;
} ;;

(* Exceptions *)
exception IdleTime of string;;
exception InvalidSchedulerState of string;;
exception NegativeLaxity of int*float;;
exception BadJobsFile of string;;

(* Special purpose code to do stuff whenever we have a problem. *)
let handleException ex outChan =
  printJobSchedule outChan !allJIDs;
  match ex with
    | NegativeLaxity (i,f) -> print_endline ("NegativeLax - job: " ^ (string_of_int i) ^ " time: " ^ (string_of_float f)); 
                              raise( NegativeLaxity(i,f))
    | _ -> raise ex
;;

(* Job encapsulates what the scheduler needs know about a job. *)

class job 
    (period : float)
    (work : float)
    (jid : int)
    (output : out_channel) =
  
    object(self) (* "self" refers to one instantiation of the class*)

    val mutable m_Status = Paused
    val mutable m_TimeUntilDeadline = 0.
    val mutable m_WorkRemaining = 0.
   (* val mutable m_ToggleTimes = [] *)

    initializer (
      m_TimeUntilDeadline <- period;
      m_WorkRemaining     <- work;
      allToggleTimes := !allToggleTimes @ [(jid, [])];
      allJIDs := !allJIDs @ [jid]
    )

    method getJID = jid
    method getWork = work
    method getPeriod = period
    method getStatus = m_Status
    method getDeadline = m_TimeUntilDeadline

    method jobFinished : bool = 
      m_WorkRemaining < epsilon 
      
    method periodFinished : bool =
      m_TimeUntilDeadline < epsilon  
    
    method laxity : float = m_TimeUntilDeadline -. m_WorkRemaining

    method getNextEvent : eventObject =
      match (m_Status) with
      | Completed -> { eventType = Release; eventLength = m_TimeUntilDeadline; creatingJob = jid } 
      | Running   -> { eventType = Completion; eventLength = m_WorkRemaining; creatingJob = jid }
      | Paused    -> { eventType = ZeroLax; eventLength = self#laxity; creatingJob = jid }    

    method setRunning (curTime : float) =
        match m_Status with 
        | Paused    -> (m_Status <- Running; 
        								let newTList =  (List.assoc jid !allToggleTimes) @ [curTime] in
                        allToggleTimes :=  (jid, newTList) :: List.remove_assoc jid !allToggleTimes)
        | Completed ->  handleException (InvalidSchedulerState ("Trying to setRunning a completed job!")) output
        | _         -> ()
    
    method setPaused (curTime : float) : unit = 
      match (m_Status) with
      | Running   -> (m_Status <- Paused; 
                     let newTList =  (List.assoc jid !allToggleTimes) @ [curTime] in
                     allToggleTimes :=  (jid, newTList) :: List.remove_assoc jid !allToggleTimes)
      | _         -> ()
                
    method setCompleted (curTime : float) =
      match (m_Status) with
      | Paused    -> handleException (InvalidSchedulerState "Trying to setCompleted a paused job!") output
      | Running   -> (m_Status <- Completed; 
                     let newTList =  (List.assoc jid !allToggleTimes) @ [curTime] in
                     allToggleTimes :=  (jid, newTList) :: List.remove_assoc jid !allToggleTimes)
      | Completed -> handleException (InvalidSchedulerState "Trying to setCompleted a completed job!") output

                    
    method releaseJob =
      match (m_Status) with
      | Completed -> (m_TimeUntilDeadline <- period;
                      m_WorkRemaining <- work;
                      m_Status <- Paused)
      | _         -> handleException 
            (InvalidSchedulerState "Trying to start a releaseJob with an uncompleted job!") output
    
    (* decrement the time until deadline, since time has advanced *)
    method decTimeUntilDeadline (event : eventObject) = (
        if (event.eventLength > (m_TimeUntilDeadline +. epsilon)) then 
              (handleException (InvalidSchedulerState "event boundary after period ends!") output);
        m_TimeUntilDeadline <- m_TimeUntilDeadline -. event.eventLength;
        if (self#periodFinished) then (self#releaseJob)
    )
    
    method decWorkRemaining (event : eventObject) (curTime : float) = (
        (* m_Status should be running *)
        if (event.eventLength > (m_WorkRemaining +. epsilon)) then 
              (handleException (InvalidSchedulerState "completion occuring between events 
              (did not cause completion event)!") output);
        m_WorkRemaining <- m_WorkRemaining -. event.eventLength;
        if (self#jobFinished) then (self#setCompleted curTime)
    )
    
    method advanceClock (event : eventObject) (curTime : float) = (              
        match (m_Status) with
            | Running   -> (self#decWorkRemaining event curTime; self#decTimeUntilDeadline event)
            | Paused    -> (if (event.eventLength > (self#laxity +. epsilon)) 
                                then (handleException (InvalidSchedulerState "NegLax occured bwtwn events")) output 
                                else self#decTimeUntilDeadline event)
            | Completed -> self#decTimeUntilDeadline event
    )
end;;

(*functions about jobs *)
let rec validateJobs (jobs : job list) (currentRate : float) (numProc : int) : bool =
  match jobs with
    | [] -> if ((float_of_int numProc) -. currentRate) 
        *. ((float_of_int numProc) -. currentRate) 
        < epsilon *. epsilon then true else false
    | hd::tl -> (if hd#getWork -. hd#getPeriod > 0. then false else 
                validateJobs tl (currentRate +. hd#getWork /. hd#getPeriod) numProc
                )
;;  

(* print the work and period of all jobs *)
let rec printJobsToStdOut (jobs : job list) =
  match jobs with 
  	| [] -> print_endline ("\nThese are the jobs we are running on -- work period")
  	| hd :: tl -> print_endline (" " ^ string_of_float hd#getWork ^ " " ^ string_of_float hd#getPeriod ); 
  	              printJobsToStdOut tl

let uncomplete (j1: job) : bool =
    j1#getStatus != Completed;;

let minEvent e1 e2 : eventObject =
    if e1.eventLength < e2.eventLength
        then e1
        else e2
;;

(*take the first n elements of the job list. *)
 let rec takeJobs (n: int) (l : job list) (out : out_channel) : job list =
     match n, l with
         | 0, _ -> []
         | _, [] -> handleException (IdleTime "Free processor, and no uncompleted job to run!") out
         | _,  (hd :: tl) -> hd :: takeJobs (n - 1) tl out;;

(* set the status to Paused for all Running jobs on the list*)
let rec pauseJobs (jobs : job list) (curTime : float) : unit =
    match jobs with
        | [] -> ()
        | hd :: tl -> hd#setPaused curTime; pauseJobs tl curTime
;;        

let rec runJobs (curTime: float)  (jobs: job list) : unit =
    match jobs with 
        | [] -> ()
        | hd :: tl -> hd#setRunning curTime; runJobs curTime tl 
;;

let checkZeroLax (job : job) =
    if job#laxity < epsilon then raise (NegativeLaxity (job#getJID, 0.))
;;

(* Here we have our n-th scheduler, earliest thingie first. *)
let comp_sched (jobs : job list) (curTime : float) (num_proc : int)
        (comp_func : job -> job -> int ) (out : out_channel) = (
    let sorted_jobs = List.sort comp_func jobs in
    let uncompleted_jobs = List.filter uncomplete sorted_jobs in
    let first_num_proc_jobs = takeJobs num_proc uncompleted_jobs out in
    let remaining_jobs = drop num_proc uncompleted_jobs in
    
    runJobs curTime first_num_proc_jobs; 
    pauseJobs remaining_jobs curTime;
    
    try
	    List.iter checkZeroLax remaining_jobs 
	  with NegativeLaxity (j, t) -> handleException (NegativeLaxity (j, curTime)) out
);;   

(* Here we have our first scheduler, least laxity first. *)
let llf (jobs : job list) (curTime : float) (num_proc : int) (out : out_channel)  = (
		let choose_lax (j1 : job) (j2 : job) : int = 
        sign (j1#laxity -. j2#laxity) 
    in
    
    comp_sched jobs curTime num_proc choose_lax out;
);;

(* Here we have our forty-second scheduler, earliest deadline first. *)
let edf (jobs : job list) (curTime : float) (num_proc : int) (out : out_channel)  = (
    let choose_edf (j1 : job) (j2 : job) : int = 
        sign (j1#getDeadline -. j2#getDeadline) 
    in
    
    comp_sched jobs curTime num_proc choose_edf out;
);;

(* Falafel *)
(* EDZL *)
(* Primal Dual *)

(* This is the heart of the scheduler, scheduling jobs. *)
class scheduler (schedImpl : job list -> float -> int -> out_channel -> unit) (output : out_channel) = 
  
  object(self)
  
  val mutable numProcessors = 0
  val mutable jobs = []
  val mutable m_Time = 0.0
      
  method getTime = m_Time
  method getJobs = jobs;

  method clockTick (time : float) : unit =
      m_Time <- (m_Time +. time)
   
  (* See what two jobs have the longest period, and return the product of the two *)
  method getMaxTime =
    let choose_period (j1 : job) (j2 : job) : int = 
      sign (j2#getPeriod -. j1#getPeriod) 
    in
    let sorted_jobs = List.sort choose_period jobs in
    (* take the first two. *)
    match sorted_jobs with
        | a :: b :: tl -> a#getPeriod *. b#getPeriod
        | _ -> max_time
      
  method generateJobs : unit =
    numProcessors <- 1 ;
    jobs <- jobs @ [(new job 3. 5. 1 output);
                    (new job 2.8 7. 2 output);
                        
                   ] 
                   
  method loadJobsFile (file : in_channel) (earliestJob : int) =
    let rec addJobs (file : in_channel) (nextJob : int) : job list =
    	try 
      	  let line = input_line file in
      	  match (Str.split (Str.regexp "[ \t]+") line) with
      	     | work::period::rest -> (
      	     										(new job (float_of_string period) 
      													     (float_of_string work)
      													     nextJob output) 
      													:: addJobs file (nextJob + 1))
      	     | _ -> []												
        with End_of_file -> []  
    in  
    numProcessors <- int_of_string(input_line file);
    jobs <- jobs @ addJobs file earliestJob;
    if not (validateJobs jobs 0. numProcessors) then (handleException (BadJobsFile "Invalid schedule") output)
      
  method scheduleWindow : float =
 
     let rec findEarliestEventRec (jobs : job list) (eEvent : eventObject) : eventObject =
        match jobs with
            | []       -> eEvent  
            | hd :: tl -> findEarliestEventRec tl (minEvent hd#getNextEvent eEvent) 
    in
    let findEarliestEvent (jobs : job list) : eventObject =
        match jobs with
            | [] -> handleException (InvalidSchedulerState "No Jobs to run!") output 
            |  _ -> findEarliestEventRec jobs (List.hd jobs)#getNextEvent 
    in
        
    (* Set status of scheduled jobs *)
    schedImpl jobs m_Time numProcessors output; 
    
    (* Increment clock to next Event*)
    let earliestEvent = findEarliestEvent jobs in
    let clockTick (time : float) : unit =
      m_Time <- (m_Time +. time)
    in
    clockTick earliestEvent.eventLength;

    let rec incrementAllJobTimes (jobs:job list)  =
        match jobs with
        | [] -> ()
        | hd :: tl -> hd#advanceClock earliestEvent m_Time;
                      incrementAllJobTimes tl
    in    
    
    (* Increment time for jobs *)
    incrementAllJobTimes jobs;
    m_Time (*return value *)
end;;

(* Main loop here *)
let firstJobID = 1 in
let outputFile = ref "scheduler.out" in

(* Arguments *)
let input_files = ref [] in
let set_input_files s = input_files := !input_files @ [s] in 

(* If this is set, we read jobs from this file. Otherwise, we call the generateJobs method *)
let generateJobs = ref true in
let jobsFile = ref "" in
let setOutputFile outf = outputFile := outf in
let setJobsFile jf = jobsFile := jf; generateJobs := false in
let schedImpl = ref llf in
let setSchedulerImpl si = 
  match si with
    | "llf" -> schedImpl := llf; print_endline (line_break ^ "Running with llf")
    | "edf" -> schedImpl := edf; print_endline (line_break ^ "Running with edf")
    | _ -> raise (InvalidSchedulerState "-s values can only be one of: llf edf")
in    

(* Parse command line args here *)
let command_line_format = 
[("-j", Arg.String setJobsFile, "If this is set, use the jobs defined in jobs_file. 
        Otherwise, call the generateJobs method to get hardcoded jobs."); 
 ("-o", Arg.String setOutputFile, "Write to file -- default scheduler.out.");
 ("-s", Arg.String setSchedulerImpl, "Use this scheduler -- possible values: llf edf"); 
] in
let _ = Arg.parse command_line_format set_input_files "Usage: simulator [-j -o -s]" in 

let outChan = open_out !outputFile in
let sched = new scheduler !schedImpl outChan in
if !generateJobs then sched#generateJobs else sched#loadJobsFile (open_in !jobsFile) firstJobID; 

(* Print what jobs we're running on *)
printJobsToStdOut sched#getJobs;

(* Now that we have the jobs, compute how long to go for *)
let maxTime = sched#getMaxTime in

let rec runJobInterval (time: float) : unit = 
  if (time < maxTime) then (runJobInterval sched#scheduleWindow )
in  

runJobInterval 0.;
print_endline "Scheduler ran to completion!";
printJobSchedule outChan !allJIDs

